The purpose of this notebook is to find markers for each of the clusters defined previously, so that we can annotate them to specific clones or cell types.
library(Seurat)
library(SeuratWrappers)
library(harmony)
library(tidyverse)
# Paths
path_to_obj <- here::here("results/R_objects/5.seurat_list_clustered.rds")
path_to_save <- here::here("results/R_objects/6.seurat_list_annotated.rds")
# Colors
color_palette <- c("black", "gray", "red", "yellow", "violet", "green4",
"blue", "mediumorchid2", "coral2", "blueviolet",
"indianred4", "deepskyblue1", "dimgray", "deeppink1",
"green", "lightgray", "hotpink1")
# Source functions
source(here::here("bin/utils.R"))
seurat_list <- readRDS(path_to_obj)
purrr::map(seurat_list, DimPlot)
## $`12`
##
## $`19`
##
## $`3299`
purrr::map(seurat_list, DimPlot, group.by = "is_richter")
## $`12`
##
## $`19`
##
## $`3299`
As upregulation of cell cycle genes is a hallmark of Richter transformation, we will infer the cell cycle score and phase for each cell:
seurat_list <- purrr::map(seurat_list, function(seurat_obj) {
seurat_obj <- CellCycleScoring(
seurat_obj,
s.features = cc.genes.updated.2019$s.genes,
g2m.features = cc.genes.updated.2019$g2m.genes,
set.ident = FALSE
)
seurat_obj
})
cc_phase_ggs <- purrr::map(seurat_list, DimPlot, group.by = "Phase")
s_score_ggs <- purrr::map(seurat_list, function(seurat_obj) {
p <- FeaturePlot(seurat_obj, features = "S.Score") +
scale_color_viridis_c(option = "magma")
p
})
g2m_score_ggs <- purrr::map(seurat_list, function(seurat_obj) {
p <- FeaturePlot(seurat_obj, features = "G2M.Score") +
scale_color_viridis_c(option = "magma")
p
})
cc_phase_ggs
## $`12`
##
## $`19`
##
## $`3299`
s_score_ggs
## $`12`
##
## $`19`
##
## $`3299`
g2m_score_ggs
## $`12`
##
## $`19`
##
## $`3299`
markers_list <- purrr::map(
seurat_list,
FindAllMarkers,
only.pos = TRUE,
logfc.threshold = 0.5
)
markers_list <- purrr::map(markers_list, function(df) {
df <- df %>%
group_by(cluster) %>%
arrange(desc(avg_log2FC), .by_group = TRUE)
df
})
print("Markers 012")
## [1] "Markers 012"
DT::datatable(markers_list$`12`)
print("Markers 019")
## [1] "Markers 019"
DT::datatable(markers_list$`19`)
print("Markers 3299")
## [1] "Markers 3299"
DT::datatable(markers_list$`3299`)
saveRDS(
markers_list,
here::here("3-clustering_and_annotation/tmp/markers_richter.rds")
)
# Split into lists of data.frames
markers_dfs_list <- list()
for (patient in names(markers_list)) {
clusters <- unique(markers_list[[patient]]$cluster)
markers_dfs <- purrr::map(clusters, function(x) {
df <- markers_list[[patient]][markers_list[[patient]]$cluster == x, ]
df <- df[, c(7, 1:6)]
df
})
names(markers_dfs) <- clusters
markers_dfs_list[[patient]] <- markers_dfs
}
We can also compare all Richter-like clones against CLL:
markers_richter_12 <- FindMarkers(
seurat_list$`12`,
ident.1 = c("2", "3"),
ident.2 = c("0", "1"),
only.pos = FALSE,
logfc.threshold = 0.5
)
DT::datatable(markers_richter_12)
markers_richter_19 <- FindMarkers(
seurat_list$`19`,
ident.1 = c("0", "1"),
ident.2 = c("2"),
only.pos = FALSE,
logfc.threshold = 0.5
)
DT::datatable(markers_richter_19)
markers_richter_3299 <- FindMarkers(
seurat_list$`3299`,
ident.1 = "2",
ident.2 = c("0", "1"),
only.pos = FALSE,
logfc.threshold = 0.5
)
DT::datatable(markers_richter_3299)
Interesting observations:
| Cluster | Markers | Annotation |
|---|---|---|
| 0 | CXCR4 | CXCR4+CD27- |
| 1 | CD27 | CXCR4-CD27+ |
| 2 | MIF | Richter-like quiescent |
| 3 | TOP2A, MKI67 | Richter-like proliferative |
| 4 | MT-ND1, MT-CO3 | poor-quality |
| 5 | MZB1, IGHM, XBP1, CLPTM1L | MZB1+IGHM++XBP1+ |
| 6 | HBM | erythrocytes |
annotation_012 <- c("CXCR4+CD27-", "CXCR4-CD27+", "Richter-like quiescent",
"Richter-like proliferative", "poor-quality",
"MZB1+IGHM++XBP1+", "erythrocytes")
seurat_list$`12`$seurat_clusters <- Idents(seurat_list$`12`)
seurat_list$`12`$annotation <- Idents(seurat_list$`12`)
levels(seurat_list$`12`$annotation) <- annotation_012
Idents(seurat_list$`12`) <- "annotation"
DimPlot(seurat_list$`12`, cols = color_palette)
| Cluster | Markers | Annotation |
|---|---|---|
| 0 | CXCR4 | CXCR4+CD27- |
| 1 | CD27 | CXCR4-CD27+ |
| 2 | CCR7 | Richter-like quiescent |
| 3 | MALAT | poor-quality |
| 4 | TOP2A, MKI67 | Richter-like proliferative |
| 5 | HBM | erythrocytes |
annotation_019 <- c("CXCR4+CD27-", "CXCR4-CD27+", "Richter-like quiescent",
"poor-quality", "Richter-like proliferative", "erythrocytes")
seurat_list$`19`$seurat_clusters <- Idents(seurat_list$`19`)
seurat_list$`19`$annotation <- Idents(seurat_list$`19`)
levels(seurat_list$`19`$annotation) <- annotation_019
Idents(seurat_list$`19`) <- "annotation"
DimPlot(seurat_list$`19`, cols = color_palette)
| Cluster | Markers | Annotation |
|---|---|---|
| 0 | CXCR4 | CXCR4+CD27- |
| 1 | CD27 | CXCR4-CD27+ |
| 2 | KLF6 | Richter-like quiescent |
| 3 | mitochondrial genes | poor-quality |
| 4 | MIR155HG | MIR155HG |
| 5 | HBM/TOP2A | erythroblast |
annotation_3299 <- c("CXCR4+CD27-", "CXCR4-CD27+", "Richter-like quiescent",
"poor-quality", "MIR155HG", "erythroblast")
seurat_list$`3299`$seurat_clusters <- Idents(seurat_list$`3299`)
seurat_list$`3299`$annotation <- Idents(seurat_list$`3299`)
levels(seurat_list$`3299`$annotation) <- annotation_3299
Idents(seurat_list$`3299`) <- "annotation"
DimPlot(seurat_list$`3299`, cols = color_palette)
In all 3 donors we have seen a a cluster of poor-quality cells, but that has a high expression of important CLL genes: CHD2 and ATM, among others. Thus, we need to check carefully before excluding them.
saveRDS(seurat_list, path_to_save)
# Save markers
walk2(markers_dfs_list, names(markers_dfs_list), function(dfs, x) {
path_to_save_dfs <- str_c(
here::here("results/tables/markers/"),
"markers_clusters_patient_",
x,
".xlsx"
)
openxlsx::write.xlsx(dfs, path_to_save_dfs)
})
sessionInfo()
## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=es_ES.UTF-8 LC_COLLATE=en_US.UTF-8 LC_MONETARY=es_ES.UTF-8 LC_MESSAGES=en_US.UTF-8 LC_PAPER=es_ES.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.6 purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.3 tidyverse_1.3.0 harmony_1.0 Rcpp_1.0.6 SeuratWrappers_0.3.0 SeuratObject_4.0.1 Seurat_4.0.1 BiocStyle_2.18.1
##
## loaded via a namespace (and not attached):
## [1] readxl_1.3.1 backports_1.2.1 plyr_1.8.6 igraph_1.2.6 lazyeval_0.2.2 splines_4.0.4 crosstalk_1.1.1 listenv_0.8.0 scattermore_0.7 digest_0.6.27 htmltools_0.5.1.1 fansi_0.4.2 magrittr_2.0.1 tensor_1.5 cluster_2.1.1 ROCR_1.0-11 openxlsx_4.2.3 limma_3.46.0 remotes_2.2.0 globals_0.14.0 modelr_0.1.8 matrixStats_0.58.0 spatstat.sparse_2.0-0 colorspace_2.0-1 rvest_1.0.0 ggrepel_0.9.1 haven_2.3.1 xfun_0.22 crayon_1.4.1 jsonlite_1.7.2 spatstat.data_2.1-0 survival_3.2-10 zoo_1.8-9 glue_1.4.2 polyclip_1.10-0 gtable_0.3.0 leiden_0.3.7 future.apply_1.7.0 abind_1.4-5 scales_1.1.1 DBI_1.1.1 miniUI_0.1.1.1 viridisLite_0.4.0 xtable_1.8-4 reticulate_1.20 spatstat.core_2.1-2 rsvd_1.0.3 DT_0.17 htmlwidgets_1.5.3 httr_1.4.2 RColorBrewer_1.1-2 ellipsis_0.3.2 ica_1.0-2 farver_2.1.0
## [55] pkgconfig_2.0.3 sass_0.4.0 uwot_0.1.10 dbplyr_2.1.0 deldir_0.2-10 here_1.0.1 utf8_1.2.1 labeling_0.4.2 tidyselect_1.1.1 rlang_0.4.11 reshape2_1.4.4 later_1.2.0 munsell_0.5.0 cellranger_1.1.0 tools_4.0.4 cli_2.5.0 generics_0.1.0 broom_0.7.5 ggridges_0.5.3 evaluate_0.14 fastmap_1.1.0 yaml_2.2.1 goftest_1.2-2 knitr_1.31 fs_1.5.0 fitdistrplus_1.1-3 zip_2.1.1 RANN_2.6.1 pbapply_1.4-3 future_1.21.0 nlme_3.1-152 mime_0.10 xml2_1.3.2 compiler_4.0.4 rstudioapi_0.13 plotly_4.9.3 png_0.1-7 spatstat.utils_2.1-0 reprex_1.0.0 bslib_0.2.5 stringi_1.6.2 highr_0.8 lattice_0.20-41 Matrix_1.3-3 vctrs_0.3.8 pillar_1.6.1 lifecycle_1.0.0 BiocManager_1.30.10 spatstat.geom_2.1-0 lmtest_0.9-38 jquerylib_0.1.4 RcppAnnoy_0.0.18 data.table_1.14.0 cowplot_1.1.1
## [109] irlba_2.3.3 httpuv_1.6.1 patchwork_1.1.1 R6_2.5.0 bookdown_0.21 promises_1.2.0.1 KernSmooth_2.23-18 gridExtra_2.3 parallelly_1.25.0 codetools_0.2-18 MASS_7.3-53.1 assertthat_0.2.1 rprojroot_2.0.2 withr_2.4.2 sctransform_0.3.2 mgcv_1.8-34 parallel_4.0.4 hms_1.0.0 grid_4.0.4 rpart_4.1-15 rmarkdown_2.7 Rtsne_0.15 shiny_1.6.0 lubridate_1.7.10